Introduction

Gordon wrote and submitted this demo after following this [Liberty BASIC conforums discussion]. This technique uses the commands

When leftButtonDown
When leftButtonMove
When leftButtonUp

to Start the drag, Do the drag, and Stop the drag respectively. In addition, calculations of MouseX, MouseY are done with respect to the Spritexy values. These values are then offset, so the sprite doesn't appear to abruptly 'snap' to the mouse position. This offsetting allows a smoother, more natural drag. (Introduction written by Janet with Gordon's permission.)

Demo: Drag and Drop

This demo uses smiley1.bmp found in the bmp folder of the Liberty BASIC folder. This demo must be run from the main Liberty BASIC program folder in order to find smiley1.bmp properly. You might also want to change instances of

playwave "bloop_x.wav", async 'Add your wave file here

to another wave file for your favored sound. The game is based upon the popular IQ Peg game. Can you leave just one peg standing?

'drag by Gordon Rahman
'with BMP background and sprite
'special thanks to Janet and Alyce
'game seen on the Internet

    notice "HELP"+chr$(13)+_
        "Jump over a ball to clear it"+chr$(13)+_
        "Jumps can be horizontal or vertical"+chr$(13)+_
        "A cleared field takes you to the next level"

    WindowWidth = 700
    WindowHeight = 700
    UpperLeftX=int((DisplayWidth-WindowWidth)/2)
    UpperLeftY=int((DisplayHeight-WindowHeight)/2)

    DIM p(6,6) p$(6,6) 'p = Playground array

    loadbmp "ssmiley",DefaultDir$+"\sprites\smiley1.bmp"

    nomainwin

    open "drag" for graphics_nsb as #1
        #1 "trapclose [quit]"
        #1 "fill green"
        #1 "backcolor darkgreen"
            FOR H=1 TO 6
                FOR V=1 TO 6
                    X=(H-1)*100+50:Y=(V-1)*100+50
                    #1, "down; place ";X;" ";Y
                    #1, "boxfilled ";X+80;" ";Y+80
                    #1, "flush"
                NEXT V
            NEXT H
        #1 "getbmp dragbg 0 0 700 700"
        #1 "getbmp mouser 0 0 1 2"
        #1 "addsprite mouser mouser"

        'get pattern
        DATA 1,0,0,0,0,0
        DATA 1,0,0,0,0,0
        DATA 1,1,0,1,1,0
        DATA 1,0,0,0,0,0
        DATA 0,0,0,0,0,0
        DATA 1,0,0,0,0,0

        DATA 0,0,0,1,0,0
        DATA 0,0,0,1,0,0
        DATA 0,0,0,1,0,0
        DATA 0,0,1,1,1,0
        DATA 0,0,1,0,0,0
        DATA 0,0,0,0,0,0

        'anchors for the smileys on the playboard
        for i = 1 to 6
            C(i) = i * 100 - 25
            R(i) = i * 100 - 25
        next i

[nextLevel]
    'initiate board values
    for R = 1 to 6
        for C = 1 to 6
            read datanumber
            if datanumber = 1 then
                p(C,R) = 1
                #1 "addsprite gcrown"+str$(q+1)+" ssmiley"
                #1 "spritexy gcrown"+str$(q+1)+" ";C(C);" ";R(R)
                p$(C,R) = "gcrown"+str$(q+1)
                q = q+1
            end if
        next C
    next R

    #1 "setfocus"
    #1 "when leftButtonDown [startDrag]"
    #1 "background dragbg"
    #1 "drawsprites"
     wait

[quit] close #1:end

[startDrag]
    #1 "spritexy mouser ";MouseX;" ";MouseY
    #1 "drawsprites";
    #1 "spritecollides mouser list$"
    if len(list$) > 0 then
        #1 "spritexy? ";list$;" shapex shapey"
        ishapex = shapex : ishapey = shapey
        iX = int((shapex+25)/100) :iY = int((shapey+25)/100)
    end if

     offsetx=MouseX-shapex
     offsety=MouseY-shapey
     #1 "when leftButtonMove [doDrag]"
     #1 "when leftButtonUp [stopDrag]"
     wait

[doDrag]
     gosub [noShape] 'erase current shape
     shapex=MouseX-offsetx
     shapey=MouseY-offsety
     gosub [drawShape] 'draw shape in new spot
     wait

[stopDrag]

    nX = int((MouseX+25)/100)
    nY = int((MouseY+25)/100)
    if abs(nX-iX)=2 and nY=iY then
        if nX > iX and p(nX-1,nY)=1 and p(nX,nY)=0 then
            p(nX,nY) = 1 : p(iX,iY) = 0 :p(nX-1,nY)=0
            #1 "spritexy ";list$;" ";C(nX);" ";R(nY)
            p$(nX,nY) = list$
            #1 "removesprite ";p$(nX-1,nY)
            #1 "drawsprites"
            playwave "bloop_x.wav", async 'Add your wave file here
            gosub [testEndGame]
            if newLevel = 1 then
                notice "NEXT LEVEL"
                #1 "removesprite ";p$(nX,nY): p(nX,nY)=0
                #1 "drawsprites"
                goto [nextLevel]
            end if
            wait
        end if
        if nX < iX and p(nX+1,nY)=1 and p(nX,nY)=0 then
            p(nX,nY) = 1 : p(iX,iY) = 0 :p(nX+1,nY)=0
            #1 "spritexy ";list$;" ";C(nX);" ";R(nY)
            p$(nX,nY) = list$
            #1 "removesprite ";p$(nX+1,nY)
            #1 "drawsprites"
            playwave "bloop_x.wav", async 'Add your wave file here
            gosub [testEndGame]
            if newLevel = 1 then
                notice "NEXT LEVEL"
                #1 "removesprite ";p$(nX,nY): p(nX,nY)=0
                #1 "drawsprites"
                goto [nextLevel]
            end if
            wait
        end if
    end if

    if abs(nY-iY)=2 and nX=iX then
        if nY > iY and p(nX,nY-1)=1 and p(nX,nY)=0 then
            p(nX,nY) = 1 : p(iX,iY) = 0 :p(nX,nY-1)=0
            #1 "spritexy ";list$;" ";C(nX);" ";R(nY)
            p$(nX,nY) = list$
            #1 "removesprite ";p$(nX,nY-1)
            #1 "drawsprites"
            playwave "bloop_x.wav", async 'Add your wave file here
            gosub [testEndGame]
            if newLevel = 1 then
                notice "NEXT LEVEL"
                #1 "removesprite ";p$(nX,nY): p(nX,nY)=0
                #1 "drawsprites"
                goto [nextLevel]
            end if
            wait
        end if
        if nY < iY and p(nX,nY+1)=1 and p(nX,nY)=0 then
            p(nX,nY) = 1 : p(iX,iY) = 0 :p(nX,nY+1)=0
            #1 "spritexy ";list$;" ";C(nX);" ";R(nY)
            p$(nX,nY) = list$
            #1 "removesprite ";p$(nX,nY+1)
            #1 "drawsprites"
            playwave "bloop_x.wav", async 'Add your wave file here
            gosub [testEndGame]
            if newLevel = 1 then
                notice "NEXT LEVEL"
                #1 "removesprite ";p$(nX,nY): p(nX,nY)=0
                #1 "drawsprites"
                goto [nextLevel]
            end if
            wait
        end if
    end if

    if len(list$) > 0 then
        playwave "blurp_x.wav", async 'Add your wave file here
        #1 "spritevisible ";list$;" on"
        #1 "spritexy ";list$;" ";ishapex;" ";ishapey
        #1 "drawsprites"
        #1 "drawsprites"
        #1 "when leftButtonMove"
    end if
    wait

[noShape]
    if len(list$) > 0 then
        #1 "spritevisible ";list$;" off"
        #1 "drawsprites"
    end if
    return

[drawShape]
    if len(list$) > 0 then
        #1 "spritexy "+list$+" ";shapex;" ";shapey
        #1 "spritevisible ";list$;" on"
        #1 "drawsprites"
    end if
    return

[testEndGame]
    newLevel = 0
    for R = 1 to 6
        for C = 1 to 6
            if p(C,R) = 1 then newLevel = newLevel + 1
        next C
    next R
    return

Thanks for sharing, Gordon!

(Editor's Note: This is just a demo, not a full game. If you try advancing beyond two levels, the program crashes with a "Read Past End of Data" message. Also, the original code was modified to remove a GOTO statement incorrectly exiting the subroutine.)

---